home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
f2pop.zip
/
F2POP.PRG
< prev
next >
Wrap
Text File
|
1993-02-23
|
9KB
|
372 lines
#include "inkey.ch"
#include "dbedit.ch"
// AutoSelect() demonstration
USE Manager NEW
INDEX ON UPPER(mgr_cd) TO Manager1
USE Rep New
INDEX ON UPPER(Mgr_cd+rep_cd) TO Rep1
cCust_cd := SPACE(3)
cMgr_cd := SPACE(3)
cMgrName := SPACE(20)
cRep_cd := SPACE(3)
cRepName := SPACE(20)
cCompany := SPACE(20)
SETKEY(K_F2, { |cP,nL,cV| PointnShoot(cP,nL,cV) } )
SETCOLOR("7+/1,4/7,,,6+/1")
SCROLL()
@ 06,01 SAY "F2Pop Demo"
@ 23,01 SAY "<Esc> Quit"
DO WHILE LASTKEY()# K_ESC
@ 09,01 SAY "Customer Information:"
@ 10,03 SAY "Cust Account #.. " GET cCust_cd
@ 11,03 SAY "Manager Code.... " GET cMgr_cd WHEN F2msg(.T.) VALID F2msg(.F.)
@ 12,03 SAY "Manager's Name.. " GET cMgrName WHEN (.F.)
@ 13,03 SAY "Sales Rep Code.. " GET cRep_Cd WHEN F2msg(.T.) VALID F2msg(.F.)
@ 14,03 SAY "Sales Rep's Name " GET cRepName WHEN (.F.)
@ 15,03 SAY "Account Name.... " GET cCompany
READ
ENDDO
SETKEY(K_F2, NIL)
*******************
FUNCTION F2Msg(lOn)
*******************
LOCAL nRow:=IIF(READVAR()=="CMGR_CD",11,13)
IF lOn
@ nRow,26 SAY "══ <F2> Lookup"
ELSE
@ nRow,26
ENDIF
RETURN (.T.)
******************************
FUNCTION PointnShoot(cP,nL,cV)
******************************
LOCAL ;
lRetval:=(.T.),;
cOldScr:=SAVESCREEN(0,0,24,79)
STATIC lIsRunning:=(.F.)
IF lIsRunning
RETURN lRetval
ENDIF
lIsRunning:=(.T.)
IF cV=="CREP_CD"
lRetval:= AutoSelect(17,22,"Rep",1,UPPER(cMgr_cd),"UPPER(Mgr_cd)",;
"mgr_cd+'│'+rep_cd+'│'+name","Mgr Rep Rep Name ",;
@cRep_cd,"rep_cd",@cRepName,"name")
ELSEIF cV=="CMGR_CD"
lRetval:= AutoSelect(17,22,"Manager",1,,,;
"mgr_cd+'│'+name","Mgr Mgr Name ",;
@cMgr_cd,"mgr_cd",@cMgrName,"name")
ENDIF
RESTSCREEN(0,0,24,79,cOldScr)
lIsRunning:=(.F.)
RETURN lRetval
// End Demo
*******************
FUNCTION AutoSelect
*******************
/*
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
By: A.J. Grace - CIS 72410,350
Syntax: AutoSelect(<nTop>, <nBot>, <cAlias>, <nIndexOrd>,
[<cSearchKey>], [<cLiteral>], <cFnames>, <cColHeader>,
[<@cGetVar1>], [<cGetField1>], [<@cGetVar2>], [<cGetField2>])
Arguments:
<nTop>, <nBot> upper and lower coordinates of DBEDIT()
<cAlias> current workarea
<nIndexOrd> current index order setting
[<cSearchKey>] primary key expression of index file
[<cLiteral>] literal prinary key expression of index file
<cFnames> database field names and/or character strings, [pictures]
<cColHeader> columm headers
[<cGetVar1>] current get name (reference variable)
[<cGetField1>] source data field loading into cGetVar
[<cGetVar2>] current get name (reference variable)
[<cGetField2>] source data field loading into cGetVar
* you may want to add more reference variables as needed
Description:
AutoSelect() uses DBEDIT() but it sports several distinctive features such as:
1.) Displaying a subset of records based on the key expression of an index file.
2.) Allows the user to search the display scope of records by simply typing the
search key from within DBEDIT()
3.) Selecting a record <K_ENTER> will populate the current get with its value.
RETURNs (.T.) IF a, selection was made
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
*/
LOCAL cOldArea:=SELECT()
PARAMETERS;
nTop ,;
nBot ,;
cAlias ,;
nIndexOrd,;
cSearchKey,;
cLiteral ,;
cFnames ,;
cColHeader,;
cGetVar1 ,;
cGetField1,;
cGetVar2 ,;
cGetField2
IF cSearchKey==NIL
cSearchKey:=""
cLiteral:="Disabled"
Disabled:=""
ENDIF
PRIVATE ;
cScanBar[1],;
cScanTitle[1],;
nCurRec,;
nBegRec,;
nEndRec,;
nRow := ROW(),;
nCol := COL(),;
cBuffer := "",;
cBoundsErr := "'" + cSearchKey + "'#" + cLiteral ,;
cMacroSub := "cSearchKey",;
nWidth := LEN(cColHeader)
cScanBar[1] := [ IIF(]+cMacroSub+[#]+cLiteral+[,SPACE(nWidth),]+cFnames+[) ]
cScanTitle[1] := cColHeader
nLeft := (80-LEN(cScanTitle[1])) / 2
nRight := nLeft+LEN(cScanTitle[1])
dbSelectArea(cAlias)
dbSetOrder(nIndexOrd)
dbSeek(cSearchKey)
// set pointer flags
nCurRec := RECNO()
nBegRec := RECNO()
nEndRec := EndRec(cSearchKey)
@ nTop-1,nLeft-1 TO nBot+1,nRight+1 DOUBLE
DBEDIT(nTop,nLeft,nBot,nRight,cScanBar,"ScanUdf",,cScanTitle)
@ nRow,nCol SAY ""
SELECT(cOldArea)
RETURN (LASTKEY()=K_ESC)
*********************************
FUNCTION ScanUdf(nStatus,nFldPtr)
*********************************
PRIVATE;
nRequest,;
nLastKey := LASTKEY()
nRequest := SubSetTest()
IF nRequest # 0
RETURN nRequest
ENDIF
SetUpSearch(nLastKey)
IF nStatus=DE_IDLE
nRequest := ScanIdle(nLastKey)
ELSEIF nStatus=DE_HITTOP
Msg( "Beginning of file." )
nRequest := DE_CONT
ELSEIF nStatus=DE_HITBOTTOM
Msg( "End of file." )
nRequest := DE_CONT
ELSEIF nStatus=DE_EMPTY
Msg( "No records on file." )
nRequest := DE_REFRESH
ELSEIF nStatus=DE_EXCEPT
// all others go this way
nRequest := ScanExcept(nLastKey)
ENDIF
// track the current record number
nCurRec := RECNO()
RETURN nRequest
**********************************
STATIC FUNCTION ScanIdle(nLastKey)
**********************************
RETURN IIF(nLastKey=K_ESC,DE_ABORT,DE_CONT)
************************************
STATIC FUNCTION ScanExcept(nLastKey)
************************************
LOCAL;
nRetval := DE_CONT,;
nCurRecNo
IF nLastKey = K_ESC
// Exit dbedit()
nRetval := DE_ABORT
ELSEIF nLastKey = K_ENTER
/*
Pass a value back to your GET (Point n Shoot)
*/
IF cGetVar1 # NIL
cGetVar1 := &cGetField1.
IF cGetVar2 # NIL
cGetVar2 := &cGetField2.
ENDIF
KEYBOARD CHR(K_ESC) + CHR(K_ENTER)
ENDIF
ELSEIF nLastKey = K_DEL
// Put your delete routine here
ELSEIF nLastKey = K_INS
// Put your add routine here to insert a line
nRetval:=DE_REFRESH // refresh screen
ELSE
// use this for you search routine
nCurRecNo := RECNO()
cBuffer := cBuffer + UPPER(CHR(nLastKey))
SEEK cSearchKey + cBuffer
IF FOUND()
nRetval:=IIF(RECNO()=nCurRecNo,DE_CONT,DE_REFRESH)
ELSE
// reset search buffer
cBuffer := ""
Msg("Search terminated.")
// put your go_to() routine goes in here
Go_To( nCurRecNo )
ENDIF
ENDIF
RETURN nRetval
**************************
STATIC FUNCTION SubSetTest
**************************
LOCAL;
nRetval := DE_ABORT,;
lBoundsErr := (&cBoundsErr. .OR.BOF().OR.EOF()) .AND. CursorKeys(nLastKey),;
cDirection := ;
IIF(nLastKey=K_UP.OR.nLastKey=K_PGUP.OR.nLastKey=K_CTRL_PGUP,"UP",;
IIF(nLastKey=K_DOWN.OR.nLastKey=K_PGDN.OR.nLastKey=K_CTRL_PGDN,"DOWN",""))
// Out of bounds error occured during a cursor key press
IF lBoundsErr
// test for last direction of cursor then reset pointer appropriately
IF cDirection="UP"
Go_To(nCurRec)
Msg("First record on file.")
ELSEIF cDirection="DOWN"
Go_To(nEndRec)
Msg("Last record on file.")
ENDIF
// reset current pointer
nCurRec := RECNO()
// reset search buffer
cBuffer := ""
nRetval := IIF(lBoundsErr, DE_CONT, DE_REFRESH)
ENDIF
RETURN nRetval
************************************
STATIC FUNCTION CursorKeys(nLastKey)
************************************
RETURN ;
nLastKey=K_PGUP .OR.;
nLastKey=K_CTRL_PGUP .OR.;
nLastKey=K_PGDN .OR.;
nLastKey=K_CTRL_PGDN .OR.;
nLastKey=K_DOWN .OR.;
nLastKey=K_UP .OR.;
nLastKey=K_ENTER .OR.;
nLastKey=K_DEL
********************************
STATIC FUNCTION SoftKey(cString)
********************************
RETURN SUBSTR(cString,1,LEN(cString)-1)+CHR(ASC(RIGHT(cString,1))+1)
*******************************
STATIC FUNCTION EndRec(cSearchKey)
*******************************
LOCAL;
nEndRec,;
nCurRec:=RECNO()
SET SOFTSEEK ON
dbSeek( SoftKey(cSearchKey) )
SET SOFTSEEK OFF
SKIP -1
nEndRec := RECNO()
Go_to( nCurRec )
RETURN nEndRec
**********************
FUNCTION Msg(cMessage)
**********************
LOCAL cOldScr:=SAVESCREEN(24,0,24,79)
@ 24,0
@ 24,2 SAY cMessage
INKEY(3)
RESTSCREEN(24,0,24,79,cOldScr)
RETURN NIL
**********************
FUNCTION Go_To(nRecNo)
**********************
LOCAL nCurRec:=RECNO()
IF nRecNo#0.AND.;
nRecNo<=RECCOUNT()+1.AND.;
nRecNo#RECNO()
IF nRecNo=RECCOUNT()+1
dbSkip(-1)
ELSE
dbGoto(nRecNo)
ENDIF
ENDIF
RETURN nCurRec
*************************************
STATIC FUNCTION SetUpSearch(nLastKey)
*************************************
IF nLastKey=K_ENTER.OR.nLastKey=K_UP.OR.nLastKey=K_DOWN.OR.nLastKey=K_PGUP.OR.;
nLastKey=K_PGDN.OR.nLastKey=29.OR.nLastKey=30.OR.nLastKey=31.OR.;
nLastKey=23.OR.nLastKey=K_F5.OR.nLastKey=K_CTRL_RET
cKey:=""
ENDIF
RETURN NIL